#/usr/bin/perl
<<DOC; 
Votre Nom : BLANCHARD DUFOUR
JANVIER 2005
 usage : perl pourcordial.pl repertoire-a-parcourir rubrique
 Le programme prend en entrée le nom du répertoire contenant les fichiers
 à traiter et le numéro de la rubrique
 Programme spécial pour générer les fichiers texte brut à étiqueter ensuite avec Cordial
DOC
#--------------------------------------------------- 
use Unicode::String qw (utf8);
use XML::RSS;
use strict;
use warnings;
use XML::Entities;

my $rss=new XML::RSS;
my %dictionnairedesfils=();
my %dictionnairedescription=();
my $rub="$ARGV[1]";
my $encodagesortie2="iso-8859-1";
my $rep="$ARGV[0]";
$rep=~ s/[\/]$//; # supprime l'éventuel /

#----------------------------------------#préparation des fichiers de sortie

my $output2="SORTIE_$rub.rss.txt";
if (!open (OUT2,">:encoding($encodagesortie2)", $output2)) { die "Pb a l'ouverture du fichier $output2"}; # si pb à ouverture du fic indique le pb et s'arrête

#----------------------------------------
&parcoursarborescencefichiers($rep);	
#----------------------------------------#fin des fichiers de sortie

close(OUT2);
exit;

#---------------------------------------------- parcours d'arborescence
sub parcoursarborescencefichiers {
    my $path = shift(@_);
    opendir(DIR, $path) or die "can't open $path: $!\n"; 
    my @files = readdir(DIR); #liste des éléments contenu dans le répertoire
    closedir(DIR);
    foreach my $file (@files) {
	next if $file =~ /^\.\.?$/;
	$file = $path."/".$file; #reconstruis le chemin 
	if (-d $file) { # est ce un répertoire? 
	
	    &parcoursarborescencefichiers($file); #relance la procédure

	}
	if (-f $file) { # est ce un fichier? 
	    
	    if (($file =~ /.+-$rub.+\.xml$/) and (-s $file !=0)){ 
	    
	        print $file,"\n";
	               
	        
		open (FILE, $file);
		    my $description=();
		    my $titre=();
		  
		    eval{$rss->parsefile($file);};
			    foreach my $item (@{$rss->{'items'}}) {
			    my $titre=$item->{'title'};
			    my $description=$item->{'description'};    
			    
			    #---------------------------------- suppression des doublons
			    if (!(exists($dictionnairedesfils{$titre})) and !(exists($dictionnairedescription{$description}))) 
			    {
				$dictionnairedesfils{$titre}++;
				$dictionnairedescription{$description}++;
			    #--------------------------------- remplace les entités xml
				$titre=XML::Entities::decode('all', $titre);
				$description=XML::Entities::decode('all', $description);
			    #---------------------------------- procédure nettoyage
				$description=&nettoyage($description);
				$titre=&nettoyage($titre);
			    #----------------------------------

					print OUT2 "$titre.\n$description.\x{00A7}\n";

			    }
			    else {
				print "Item déjà vu\n";
			    }
		    }
			    
		    close (FILE);

		    }
		}
	}
    }

#---------------------------------------------- nettoyage

sub nettoyage {
		my $chainetrouvee = shift@_;
		$chainetrouvee=~s /&#38;#39;/'/g;
		$chainetrouvee=~s /&#39;/'/g;
		$chainetrouvee=~s /&#38;#34;/"/g;
		$chainetrouvee=~s /&#34;/"/g;
		$chainetrouvee=~s /&#91;/[/g;
		$chainetrouvee=~s /&#93;/]/g;
		$chainetrouvee=~s /&#233;/é/g;
		$chainetrouvee=~s /e\x{0300}/è/g;
		$chainetrouvee=~s /&#234;/ê/g;
		$chainetrouvee=~s /\x{0119}/ę/g;
		$chainetrouvee=~s/\x{2192}/→/g;
		$chainetrouvee=~s/\x{201c}/"/g;
		$chainetrouvee=~s /âœ/"/g;
		$chainetrouvee=~s/\x{201d}/"/g;
		$chainetrouvee=~s /â/"/g;
		$chainetrouvee=~s /âÅ/"/g;
		$chainetrouvee=~s/\x{2019}/'/g;
		$chainetrouvee=~s/\x{2018}/'/g;
		$chainetrouvee=~s/\x{2013}/-/g;
		$chainetrouvee=~s/\x{2014}|â/-/g;
		$chainetrouvee=~s/\x{2212}/-/g; 
		$chainetrouvee=~s /\x{2026}/.../g;
		$chainetrouvee=~s /\x{0153}/oe/g;
		$chainetrouvee=~s /\x{0152}/Œ/g;
		$chainetrouvee=~s /\x{0096}/-/g;
		$chainetrouvee=~s /\x{009C}/oe/g;
		$chainetrouvee=~s /\x{0093}/oe/g;
		$chainetrouvee=~s /\x{200a}/ /g;
		$chainetrouvee=~s /\x{200b}/ /g;
		$chainetrouvee=~s /\x{305a}\x{305a}\x{3063}\x{3068}/zuzutto/g;
		$chainetrouvee=~s /ÅÅ/oe/g;
		$chainetrouvee=~s /Å/oe/g;
		$chainetrouvee=~s /&/and/g;
		$chainetrouvee=~s /"/"/g;
		#$chainetrouvee=~s /â¯//g;
		$chainetrouvee=~s/\x{20ac}/€/g;
		$chainetrouvee=~s/\x{2009}/ /g; #espace court
		$chainetrouvee=~s/\x{fffd}/�/g;
		$chainetrouvee=~s /&lt;.*?&gt;//g;
		$chainetrouvee=~s /<img.*?\/>//g;
		$chainetrouvee=~s /<a href.*?><\/a>//g;
		$chainetrouvee=~s /<p>&nbsp;&nbsp;\n<\/p>//g;
		$chainetrouvee=~s /<[^<]*>//g;
		return $chainetrouvee;
}